home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / music / 7 / pascal / copy.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-19  |  2.8 KB  |  97 lines
  1. PROGRAM copy_pas ;
  2.  
  3.   CONST
  4.     chunk_size = 4096 ;
  5.     fn_length = 64 ;
  6.  
  7.   TYPE
  8.     buffer_type = PACKED ARRAY [ 1..chunk_size ] OF byte ;
  9.     file_name_type = PACKED ARRAY [ 1..fn_length ] OF char ;
  10.  
  11.   VAR
  12.     fname : STRING ;
  13.     buf : buffer_type ;
  14.     i, in_file, out_file : integer ;
  15.     name : file_name_type ;
  16.  
  17.   FUNCTION gem_create( VAR fname : file_name_type ; mode : integer ) : integer;
  18.     GEMDOS( $3C ) ;
  19.  
  20.   FUNCTION gem_open( VAR fname : file_name_type ; mode : integer ) : integer;
  21.     GEMDOS( $3D ) ;
  22.  
  23.   PROCEDURE gem_close( handle : integer ) ;
  24.     GEMDOS( $3E ) ;
  25.  
  26.   FUNCTION gem_read( handle : integer ; nbytes : long_integer ;
  27.                 VAR buf : buffer_type ) : long_integer ;
  28.     GEMDOS( $3F ) ;
  29.  
  30.   FUNCTION gem_write( handle : integer ; nbytes : long_integer ;
  31.                 VAR buf : buffer_type ) : long_integer ;
  32.     GEMDOS( $40 ) ;
  33.  
  34.   PROCEDURE gem_seek( nbytes : long_integer ; handle, mode : integer ) ;
  35.     GEMDOS( $42 ) ;
  36.  
  37.   PROCEDURE copy_file( in_file, out_file : integer ) ;
  38.  
  39.     VAR
  40.       n : long_integer ;
  41.  
  42.     BEGIN
  43.       REPEAT
  44.         gem_close( out_file ) ;         { Close down the output! }
  45.         out_file := gem_open( name, 1 ) ;
  46.         gem_seek( 0, out_file, 2 ) ;    { Seek end-of-file }
  47.         n := gem_read( in_file, chunk_size, buf ) ;
  48.         writeln( 'read chunk of ', n, ' bytes' ) ;
  49.         IF n < 0 THEN
  50.           BEGIN
  51.             writeln( 'error ', n, ' on input file' ) ;
  52.             halt ;
  53.           END
  54.         ELSE IF n > 0 THEN
  55.           IF gem_write( out_file, n, buf ) = n THEN
  56.             writeln( 'wrote chunk properly' )
  57.           ELSE
  58.             BEGIN
  59.               writeln( 'error writing output file' ) ;
  60.               halt ;
  61.             END ;
  62.       UNTIL n = 0 ;
  63.     END ;
  64.  
  65.   BEGIN
  66.     write( 'Source file: ' ) ;
  67.     readln( fname ) ;
  68.     FOR i := 1 TO length( fname ) DO
  69.       name[i] := fname[i] ;
  70.     name[ length(fname) + 1 ] := chr(0) ;
  71.     in_file  := gem_open( name, 0 ) ;
  72.     IF in_file >= 0 THEN
  73.       writeln( 'opened input file' )
  74.     ELSE
  75.       BEGIN
  76.         writeln( 'error ', in_file, ' opening input' ) ;
  77.         halt ;
  78.       END ;
  79.     write( 'Destination file: ' ) ;
  80.     readln( fname ) ;
  81.     FOR i := 1 TO length( fname ) DO
  82.       name[i] := fname[i] ;
  83.     name[ length(fname) + 1 ] := chr(0) ;
  84.     out_file := gem_create( name, 0 ) ;
  85.     IF out_file >= 0 THEN
  86.       writeln( 'opened output file' )
  87.     ELSE
  88.       BEGIN
  89.         writeln( 'error ', out_file, ' opening output' ) ;
  90.         halt ;
  91.       END ;
  92.     copy_file( in_file, out_file ) ;
  93.     gem_close( in_file ) ;
  94.     gem_close( out_file ) ;
  95.   END.
  96.  
  97. 